perm filename FLOAT.LAP[TIM,LSP] blob
sn#719126 filedate 1983-07-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00016 00003
C00018 00004
C00020 ENDMK
C⊗;
'(THIS IS THE LAP FOR ((DSK (TIM LSP)) FLOAT LSP))
'(COMPILED BY LISP COMPILER /936 COMAUX /25 PHAS1 /84 MAKLAP /80 INITIA /117)
;COMPILED ON JULY 11, 1983, AT 5:40 PM
(LAP MACHAR SUBR)
(ARGS MACHAR (() . 0))
(PUSH FXP (% 0))
(PUSH FLP (% 0.0))
(PUSH FLP (% 1.0))
(PUSH FLP (% 0.0))
(MOVE 7 -1 FLP)
(FADR 7 7)
(PUSH FLP 7)
G0002
(MOVE 7 0 FLP)
(FADR 7 -2 FLP)
(FSBR 7 0 FLP)
(FSBR 7 -2 FLP)
(JUMPE 7 G0036)
(MOVE 7 0 FLP)
(MOVEM 7 -1 FLP)
(JSP T FLCONS)
(JRST 0 G0042)
G0036
(MOVE 7 0 FLP)
(FADR 7 7)
(MOVEM 7 0 FLP)
(JRST 0 G0002)
G0042
(SUB FLP (% 0 0 1 1))
(PUSH FLP (% 0.0))
(MOVE 7 -2 FLP)
(FADR 7 7)
(PUSH FLP 7)
G0004
(MOVE 7 -2 FLP)
(FADR 7 0 FLP)
(FSBR 7 -2 FLP)
(JUMPE 7 G0045)
(MOVE 7 0 FLP)
(MOVEM 7 -1 FLP)
(JSP T FLCONS)
(JRST 0 G0050)
G0045
(MOVE 7 0 FLP)
(FADR 7 7)
(MOVEM 7 0 FLP)
(JRST 0 G0004)
G0050
(SUB FLP (% 0 0 1 1))
(MOVE 7 -1 FLP)
(FADR 7 0 FLP)
(FSBR 7 -1 FLP)
(MULI 7 400)
(TSC 7 7)
(ASH 10 -243 7)
(MOVE 7 10)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *IBETA*))
(MOVE 7 0 1)
(JSP T IFLOAT)
(PUSH FLP 7)
(FMPR 7 -3 FLP)
(PUSH FXP (% 1))
(PUSH FLP 7)
G0007
(MOVE 7 0 FLP)
(FADR 7 -4 FLP)
(FSBR 7 0 FLP)
(FSBR 7 -4 FLP)
(JUMPE 7 G0058)
(MOVE 7 0 FXP)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *IT*))
(JRST 0 G0064)
G0058
(MOVE 7 0 FXP)
(ADDI 7 1)
(MOVE 10 -1 FLP)
(FMPRB 10 0 FLP)
(MOVEM 7 0 FXP)
(JRST 0 G0007)
G0064
(SUB FXP (% 0 0 1 1))
(SUB FLP (% 0 0 1 1))
(MOVEI 5 '0)
(MOVEM 5 (SPECIAL *IRND*))
(MOVE 7 0 FLP)
(FSBR 7 -3 FLP)
(PUSH FLP 7)
(FADR 7 -3 FLP)
(FSBR 7 -3 FLP)
(JUMPE 7 G0068)
(MOVEI 4 '1)
(MOVEM 4 (SPECIAL *IRND*))
G0068
(MOVE 7 @ (SPECIAL *IT*))
(ADDI 7 3)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *NEGEP*))
(MOVE 7 -4 FLP)
(FDVR 7 -1 FLP)
(PUSH FLP 7)
(FMPR 7 -5 FLP)
(PUSH FXP 0 1)
(PUSH FLP 7)
G0011
(MOVE 7 0 FXP)
(JUMPN 7 G0076)
(MOVE 7 0 FLP)
(MOVEM 7 -5 FLP)
(JSP T FLCONS)
(JRST 0 G0079)
G0076
(SUBI 7 1)
(MOVE 10 -1 FLP)
(FMPRB 10 0 FLP)
(MOVEM 7 0 FXP)
(JRST 0 G0011)
G0079
(SUB FXP (% 0 0 1 1))
(SUB FLP (% 0 0 1 1))
(PUSH FLP -4 FLP)
(PUSH FXP @ (SPECIAL *NEGEP*))
(PUSH FLP 0 FLP)
G0015
(MOVE 7 -7 FLP)
(FSBR 7 0 FLP)
(FSBR 7 -7 FLP)
(JUMPE 7 G0082)
(MOVN 7 0 FXP)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *NEGEP*))
(MOVE 7 0 FLP)
(MOVEM 7 -1 FLP)
(JSP T FLCONS)
(JRST 0 G0089)
G0082
(MOVE 7 0 FLP)
(FMPR 7 -4 FLP)
(MOVNI 10 1)
(ADDB 10 0 FXP)
(MOVEM 7 0 FLP)
(JRST 0 G0015)
G0089
(SUB FXP (% 0 0 1 1))
(SUB FLP (% 0 0 1 1))
(MOVE 7 0 FLP)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *EPSNEG*))
(MOVE 7 @ (SPECIAL *IBETA*))
(CAIN 7 2)
(JRST 0 G0094)
(MOVE 7 @ (SPECIAL *IRND*))
(JUMPE 7 G0094)
(MOVE 7 -6 FLP)
(FADR 7 0 FLP)
(FMPR 7 0 FLP)
(MOVE 10 -6 FLP)
(FADR 10 10)
(FDVR 7 10)
(MOVEM 7 0 FLP)
(MOVE 7 -6 FLP)
(FSBR 7 0 FLP)
(FSBR 7 -6 FLP)
(JUMPE 7 G0094)
(MOVE 7 0 FLP)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *EPSNEG*))
G0094
(MOVN 7 @ (SPECIAL *IT*))
(SUBI 7 3)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *MACHEP*))
(SUB FLP (% 0 0 1 1))
(PUSH FLP -4 FLP)
(PUSH P 1)
G0018
(MOVE 7 -6 FLP)
(FADR 7 0 FLP)
(FSBR 7 -6 FLP)
(JUMPE 7 G0107)
(MOVE 7 0 FLP)
(MOVE 1 0 P)
(JSP T PDLNMK)
(MOVEM 1 (SPECIAL *MACHEP*))
(MOVEM 7 -5 FLP)
(MOVE 7 0 FLP)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *EPS*))
(JRST 0 G0113)
G0107
(MOVE 7 0 FLP)
(FMPR 7 -3 FLP)
(MOVE 10 @ 0 P)
(ADDI 10 1)
(MOVEM 10 0 FXP)
(MOVEI 1 0 FXP)
(MOVEM 1 0 P)
(MOVEM 7 0 FLP)
(JRST 0 G0018)
G0113
(SUB P (% 0 0 1 1))
(SUB FLP (% 0 0 1 1))
(MOVE 7 @ (SPECIAL *IBETA*))
(CAIN 7 2)
(JRST 0 G0116)
(MOVE 7 @ (SPECIAL *IRND*))
(JUMPE 7 G0116)
(MOVE 7 -5 FLP)
(FADR 7 -4 FLP)
(FMPR 7 -4 FLP)
(MOVE 10 -5 FLP)
(FADR 10 10)
(FDVR 7 10)
(MOVEM 7 -4 FLP)
(FADR 7 -5 FLP)
(FSBR 7 -5 FLP)
(JUMPE 7 G0116)
(MOVE 7 -4 FLP)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *EPS*))
G0116
(MOVEI 5 '0)
(MOVEM 5 (SPECIAL *NGRD*))
(MOVE 7 @ (SPECIAL *IRND*))
(JUMPN 7 G0126)
(MOVE 7 -5 FLP)
(FADR 7 @ (SPECIAL *EPS*))
(MOVSI 10 0)
(FSBR 10 7)
(JUMPE 10 G0126)
(MOVEI 4 '1)
(MOVEM 4 (SPECIAL *NGRD*))
G0126
(PUSH FXP (% 0))
(PUSH FXP (% 0))
(PUSH FLP (% 0.0))
(MOVE 7 -1 FLP)
(FMPR 7 7)
(MOVEM 7 -7 FLP)
(MOVEI 5 -7 FLP)
(MOVE 7 0 5)
(FMPR 7 -6 FLP)
(PUSH FXP (% 1))
(PUSH FLP -1 FLP)
(PUSH FLP 0 5)
(PUSH FXP (% 0))
(PUSH FLP 7)
(PUSH FXP (% 0))
G0024
(MOVE 7 0 FLP)
(FADR 7 7)
(JUMPE 7 G0134)
(MOVM 7 -1 FLP)
(CAMG 7 -2 FLP)
(JRST 0 G0132)
G0134
(MOVE 7 -2 FLP)
(MOVE 10 -2 FXP)
(MOVE 11 0 FLP)
(MOVEM 7 -3 FLP)
(MOVEM 10 -3 FXP)
(MOVEM 11 -10 FLP)
(MOVE 7 @ (SPECIAL *IBETA*))
(CAIE 7 12)
(JRST 0 G0138)
(PUSH P (% 0 0 '2))
(PUSH FXP 7)
G0026
(MOVE 7 -4 FXP)
(CAML 7 0 FXP)
(JRST 0 G0139)
(MOVE 1 0 P)
(JSP T PDLNMK)
(MOVEM 1 (SPECIAL *IEXP*))
(MOVE 7 0 FXP)
(ADD 7 7)
(SUBI 7 1)
(MOVEM 7 -5 FXP)
(JSP T FXCONS)
(JRST 0 G0145)
G0139
(MOVE 7 0 FXP)
(IMUL 7 @ (SPECIAL *IBETA*))
(MOVE 10 @ 0 P)
(ADDI 10 1)
(MOVEM 10 -1 FXP)
(MOVEI 1 -1 FXP)
(MOVEM 1 0 P)
(MOVEM 7 0 FXP)
(JRST 0 G0026)
G0145
(SUB P (% 0 0 1 1))
(SUB FXP (% 0 0 1 1))
(JSP T PDLNMK)
(JRST 0 G0137)
G0138
(MOVE 7 -1 FXP)
(ADDI 7 1)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *IEXP*))
(ADD 10 10)
(MOVE 7 10)
(JSP T FXCONS)
(MOVEM 10 -4 FXP)
G0137
(JRST 0 G0156)
G0132
(AOS 0 -1 FXP)
(MOVE 7 -2 FXP)
(ADD 7 7)
(MOVE 10 -1 FLP)
(FMPR 10 10)
(MOVE 11 -1 FLP)
(FMPR 11 -11 FLP)
(MOVEM 7 -2 FXP)
(MOVE 7 -1 FLP)
(MOVEM 7 -2 FLP)
(MOVEM 10 -1 FLP)
(MOVEM 11 0 FLP)
(JRST 0 G0024)
G0156
(SUB FXP (% 0 0 3 3))
(SUB FLP (% 0 0 3 3))
(PUSH FXP (% 0))
(MOVE 7 0 FLP)
(FMPR 7 -6 FLP)
(PUSH FLP 0 FLP)
(PUSH FLP -1 FLP)
(PUSH FXP -1 FXP)
(PUSH FLP 7)
G0032
(MOVE 7 0 FLP)
(FADR 7 7)
(JUMPE 7 G0163)
(MOVM 7 -1 FLP)
(CAMGE 7 -2 FLP)
(JRST 0 G0161)
G0163
(MOVE 7 -2 FLP)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *XMIN*))
(MOVE 7 0 FXP)
(MOVE 10 0 FLP)
(MOVEM 7 -2 FXP)
(MOVNS 0 7)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *MINEXP*))
(MOVEM 10 -10 FLP)
(MOVE 7 -2 FXP)
(ADD 7 7)
(SUBI 7 3)
(CAMGE 7 -3 FXP)
(JRST 0 G0169)
(MOVE 7 @ (SPECIAL *IBETA*))
(CAIN 7 12)
(JRST 0 G0169)
(MOVE 7 -3 FXP)
(ADD 7 7)
(MOVE 10 @ (SPECIAL *IEXP*))
(ADDI 10 1)
(MOVEM 7 -3 FXP)
(MOVE 7 10)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *IEXP*))
G0169
(MOVE 7 -3 FXP)
(ADD 7 @ (SPECIAL *MINEXP*))
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *MAXEXP*))
(MOVE 7 0 1)
(ADD 7 @ (SPECIAL *MINEXP*))
(MOVEM 7 -1 FXP)
(MOVE 7 @ (SPECIAL *IBETA*))
(CAIE 7 2)
(JRST 0 G0179)
(MOVE 7 -1 FXP)
(JUMPN 7 G0179)
(MOVE 7 0 1)
(SUBI 7 1)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *MAXEXP*))
G0179
(MOVE 7 -1 FXP)
(CAIG 7 24)
(JRST 0 G0183)
(MOVE 7 @ (SPECIAL *MAXEXP*))
(SUBI 7 1)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *MAXEXP*))
G0183
(MOVE 7 -10 FLP)
(CAMN 7 -3 FLP)
(JRST 0 G0187)
(MOVE 7 @ (SPECIAL *MAXEXP*))
(SUBI 7 2)
(JSP T FXCONS)
(MOVEM 1 (SPECIAL *MAXEXP*))
G0187
(MOVE 7 -11 FLP)
(FSBR 7 @ (SPECIAL *EPSNEG*))
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *XMAX*))
(MOVE 7 0 1)
(FMPR 7 -11 FLP)
(CAMN 7 0 1)
(JRST 0 G0193)
(MOVE 7 -6 FLP)
(FMPR 7 @ (SPECIAL *EPSNEG*))
(MOVE 10 -11 FLP)
(FSBR 10 7)
(MOVE 7 10)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *XMAX*))
G0193
(MOVE 7 -6 FLP)
(FMPR 7 7)
(FMPR 7 -6 FLP)
(FMPR 7 @ (SPECIAL *XMIN*))
(MOVE 10 @ (SPECIAL *XMAX*))
(FDVR 10 7)
(MOVE 7 10)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *XMAX*))
(MOVE 7 @ (SPECIAL *MAXEXP*))
(ADD 7 @ (SPECIAL *MINEXP*))
(ADDI 7 3)
(MOVEM 7 -1 FXP)
(JUMPLE 7 G0207)
(PUSH FXP 7)
G0034
(MOVE 7 0 FXP)
(JUMPE 7 G0209)
(MOVE 7 @ (SPECIAL *IBETA*))
(CAIE 7 2)
(JRST 0 G0211)
(MOVE 7 @ (SPECIAL *XMAX*))
(FADR 7 7)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *XMAX*))
(JRST 0 G0210)
G0211
(MOVE 7 @ (SPECIAL *XMAX*))
(FMPR 7 -6 FLP)
(JSP T FLCONS)
(MOVEM 1 (SPECIAL *XMAX*))
G0210
(SOS 0 0 FXP)
(JRST 0 G0034)
G0209
(MOVEI 1 '() )
(SUB FXP (% 0 0 1 1))
(JRST 0 G0206)
G0207
(MOVEI 1 '() )
G0206
(JRST 0 G0219)
G0161
(MOVE 7 -1 FLP)
(FMPR 7 -4 FLP)
(MOVE 10 -1 FLP)
(FMPR 10 -11 FLP)
(MOVEI 11 1)
(ADDB 11 0 FXP)
(PUSH FLP -1 FLP)
(POP FLP 11)
(MOVEM 7 -1 FLP)
(MOVEM 10 0 FLP)
(MOVEM 11 -2 FLP)
(JRST 0 G0032)
G0219
(SUB FXP (% 0 0 5 5))
(SUB FLP (% 0 0 13 13))
(POPJ P)
()
(LAP SQUARE-ROOT SUBR)
(ARGS SQUARE-ROOT (() . 1))
(PUSH FLP 0 1)
(MOVE 7 0 FLP)
(JUMPN 7 G0005)
(MOVEI 1 '0.0)
(JRST 0 G0004)
G0005
(JUMPGE 7 G0006)
(CALL 0 '*TERPRI)
(STRT 0 (% SIXBIT |S↑1↑5↑!↑2↑%-↑2↑//↑//↑4 ↑//↑& ↑! ↑.↑%↑'↑!↑4↑)↑6↑% ↑.↑5↑-↑"↑%↑2!|))
(CALL 0 '*TERPRI)
(MOVEI 1 '0.0)
(JRST 0 G0004)
G0006
(NCALL 1 'INTXP)
(MOVEI 2 '0)
(MOVEI 1 0 FLP)
(PUSH FXP 7)
(NCALL 2 'SETXP)
(PUSH FLP 7)
(FMPR 7 (% 0.59016))
(FADR 7 (% 0.41731))
(PUSH FLP 7)
(PUSH FXP (% 3))
(PUSH FLP 7)
G0003
(MOVE 7 0 FXP)
(JUMPN 7 G0012)
(MOVE 7 -1 FXP)
(TRNN 7 1)
(JRST 0 G0014)
(MOVE 7 (% 0.552023634))
(FMPRB 7 0 FLP)
G0014
(MOVE 7 -1 FXP)
(IDIVI 7 2)
(PUSH FXP 7)
(MOVEI 2 0 FXP)
(MOVEI 1 0 FLP)
(CALL 2 'ADX)
(SUB FXP (% 0 0 1 1))
(JRST 0 G0019)
G0012
(SUBI 7 1)
(MOVE 10 -2 FLP)
(FDVR 10 0 FLP)
(FADR 10 0 FLP)
(FSC 10 -1)
(MOVEM 7 0 FXP)
(MOVEM 10 0 FLP)
(JRST 0 G0003)
G0019
(SUB FXP (% 0 0 2 2))
(SUB FLP (% 0 0 3 3))
G0004
(SUB FLP (% 0 0 1 1))
(POPJ P)
()
(LAP INTXP SUBR)
(args intxp (nil . 1))
(move t 0 a) ;gets the machine representation of x
(ldb tt bpt) ;extracts the exponent (bits 1-8 on a PDP-10)
(subi tt #o200) ;the exponent is stored excess #o200
(jrst 0 fix1) ;fxcons it
(entry adx subr)
(args adx (nil . 2))
(move tt 0 a) ;get x
(ldb t bptt) ;get exponent
(add t 0 b) ;add n
(dpb t bptt) ;put the new exponent in place
(jrst 0 float1) ;float CONS it
(entry setxp subr)
(args setxp (nil . 2))
(move tt 0 a) ;get x
(move t 0 b) ;get n
(addi t #o200) ;make up excess #o200 exponent
(dpb t bptt) ;install the exponent
(jrst 0 float1) ;float CONS
bpt (331000←22 0 t);byte pointers
bptt (331000←22 0 tt)
()
(COMMENT **** (ADX SETXP)
have been used but remain undefined in this file)